home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / AVAILTST.M < prev    next >
Encoding:
Text File  |  1992-02-15  |  2.2 KB  |  74 lines
  1. MODULE MemTest;
  2. (*$E MOS *)
  3. IMPORT TOSIO;
  4.  
  5.   (* Fehler im Modula-System: Irgendwas ist im Storage-Modul schiefgelaufen.
  6.    * Soweit ich den Fehler ausmachen kann, liefern die Abfrageprozeduren
  7.    * für den freien Speicherplatz nach einer bestimmten Anzahl von Aufrufen
  8.    * mit anschließender Speicherallokation falsche Werte.
  9.    *
  10.    * Die hier aufgeführte Prozedur testIt macht das deutlich. In einer
  11.    * WHILE-Schleife wird auf 8kByte freien Speicherplatz abgefragt und dann
  12.    * ein wesentlich kleinerer Speicherbereich alloziiert, d.h. die Allokation
  13.    * müßte eigentlich immer erfolgreich ablaufen (was aber bei dem neuesten
  14.    * Modula-Update nicht der Fall ist; bei der älteren Version funktionierte
  15.    * es ganz wunderbar !)
  16.    *)
  17.  
  18. FROM InOut      IMPORT WriteString, WriteLn, WriteCard, Read;
  19. FROM GEMEnv     IMPORT InitGem, ExitGem, GemError, CurrGemHandle, RC,
  20.                        DeviceHandle, GemHandle;
  21. FROM Storage    IMPORT ALLOCATE, MemAvail, Available;
  22.  
  23. VAR  success    : BOOLEAN;
  24.      dev        : DeviceHandle;
  25.      gemHdl     : GemHandle;
  26.      c          : CHAR;
  27.  
  28. PROCEDURE testIt;
  29. CONST amount = 128000;
  30. VAR block : POINTER TO CHAR;
  31.     ok    : BOOLEAN;
  32.     count : CARDINAL;
  33.   BEGIN
  34.     WriteString('Speicher wird alloziert...'); WriteLn;
  35.     ok:=TRUE; count:=0;
  36.  
  37.     (*
  38.     ok:= FALSE;
  39.     *)
  40.     WHILE ok & Available (amount) DO
  41.     (*(MemAvail()>LONG(8192)) DO*)
  42.       ALLOCATE(block,amount);
  43.  
  44.       ok:=block#NIL;    (* Dürfte eigentlich nie FALSE werden, da ja vorher
  45.                          * auf viel mehr Speicher abgeprüft wird !
  46.       ******************** Der Fehler tritt übrigens auch dann auf, wenn
  47.       * statt auf MemAvail()>LONG(8192) zum Beispiel auf Available(amount)
  48.       * abgefragt wird.
  49.       *)
  50.       
  51.       IF ok THEN INC(count) END
  52.     END;
  53.  
  54.     IF ~ok THEN
  55.       WriteString('Fehler eingetreten nach ');
  56.       WriteCard(count,0);
  57.       WriteString(' Allokationen. MemAvail() = ');
  58.       WriteCard(MemAvail(),0);
  59.     ELSE WriteString('Kein Fehler.') END;
  60.     WriteLn
  61.   END testIt;
  62.  
  63. BEGIN
  64.   InitGem(RC, dev, success);
  65.   IF success THEN
  66.     gemHdl:=CurrGemHandle();
  67.  
  68.     testIt;
  69.     Read(c);
  70.  
  71.     ExitGem(gemHdl)
  72.   END
  73. END MemTest.
  74.